{******************************************************} { } { ToolTip unit version 2.1 for Borland Pascal } { Requires Windows 3.1, ToolBar and ObjectWindows } { Copyright (c) 1994 by Antony Lewis } { } {******************************************************} {This unit contains a Toolbar object descended from the toolbar object supplied with Turbo Pascal. It pops up a little tip window when the cursor is held over a tool button for a specified time. This is a very useful tool to help people use your program as the function of toolbar icons is often far from obvious. The toolbar object loads itself from a custom resource type like the normal toolbar. Here, however the type is HelpToolBarData which can be edited using Resource Workshop. In addition to the data supplied in ToolBarData resourced, it also as the tip text associated with each button. The format of HelpToolBarData is much like the ToolBarData type, except the nul-terminated string after the command value for each button. For example (You cannot have the comments in an actual resource statement) MyHelpToolbar HELPTOOLBARDATA BEGIN 4 (Total number of buttons and spacers in resource ) tbHelp (bitmap id (here a pascal identifier) ) cmHelp (menu command id of button ) "Help\0" (Nul-terminated tip text ) 0 (inserts a space between buttons. You wont need a ) 8 (tip text for a spacer ) tbOpen (Start definition of next button ) cmOpen "Open\0" tbSave cmSave "Save\0" END There are two ToolBar objects in this unit: THelpToolBar and TColorToolTipBar. The first of these pops up a static text control with the tip in, the second pops up a smaller, coloured background tip window. The TColorToolTipBar object is descended from the THelpToolBar object, and can be used in exactly the same way. The TColorToolTipBar however is slightly slower and takes up more space. A program could create a toolbar from a HelpToolBarData resource with, for example MyHelpToolBar := New(PHelpToolbar, Init(@Self, 'MyHelpToolbar', tbHorizontal, 700)); or, for to show colourful tips, MyHelpToolBar := New(PColorToolTipBar, Init(@Self, 'MyHelpToolBar', tbHorizontal ,700)); The last parameter is the delay time, in milliseconds, before displaying the hint. To convert an existing applications using the Borland ToolBar objects: 1. For plain tips replace all references to TToolBar with THelpToolBar, TToolButton with THelpToolButton, and similarly for the pointers 2. For colour tips replace references to TToolBar with TColorToolTipBar, TToolButton with TColorToolButton, and similarly for the pointers and add the ToolTip unit to the unit's uses clause. For a demonstration of the ToolTip unit compile the DEMO.PAS program supplied. The resource file for this program is the DEMO.RC script. The ToolTip unit makes use of the Application's ProcessAppMsg method to trap keystrokes. Make sure that the OWindows unit you are using is the same as that supplied by Borland} The ToolTip unit is distributed as ShareWare. If you wish to continue using the program after 30 days evaluation you must register. Registering gives you the right to unlimited distribution of your program(s) using the ToolTip unit. To register please send 30 US Dollars or 20 Pounds Sterling to Antony Lewis, 16 Townley Rd, London SE22 8SR, UK giving your name and address. If you wish to have the full source code for the unit there is an additional charge of 15 US Dollars or 10 Pounds Sterling, including P&P of the source code on disk, making a total fee of 45 US Dollars or 30 Pounds. I can be contacted by E-Mail on AML1005@CAM.AC.UK} {Here follows the declaration parts of the source code} {$X+} unit ToolTip; interface uses Toolbar, WinProcs, WinTypes, OWindows, ODialogs, Objects; Type PHelpToolButton=^THelpToolButton; THelpToolButton=Object(TToolButton) Delay:Word; {Time over button before showing help} HelpText:PChar; {Pointer to text to display} HasHelped:Boolean; {Doesn't display tip once button is used and HasHelped is true} TipWidth,TipHeight:Integer; {Width and Height of tip window. Height is set to -1 by init} constructor Init(AParent: PWindowsObject; X, Y: Integer;ACommand: Word;BitmapName: PChar;ADelay:Word); {As for TToolButton, except the additional ADelay parameter. This should be the delay time in milliseconds before displayng the help window} destructor Done;virtual; {Clears up HelpText} function GetHelpTipWindow:PWindow;virtual; {By default returns a TTipWindow, with a static control in. GetHelpTipWindow calculates width of HelpText and returns TTipWIndow of the appropriate width and height. Override this to display a different descendant of TTipWindow. Return Nil to not display a tip} procedure Read(var S: TStream); virtual; {Reads HelpText and Delay} procedure Write(var S: TStream); virtual; {Writes HelpText and Delay} end; Type PHelpToolBar=^THelpToolBar; THelpToolBar=Object(TToolBar) OldCapture:HWnd; {Window having capture before the toolbar} HasCaptured:Boolean; {If toolbar has the mouse capture} Selected:PHelpToolButton; {If mouse is over button, points to selected button} DelayTime:Word; {Delay time which all the buttons are set to by default} NoHelp:Boolean; {If tips are diabled} HelpTipWindow:PWindow; {Pointer to the tip window. Nil when not tip showing} GlobalMousePos:TPoint; {Position of the mouse in screen co-ordinates when mouse is over button} constructor Init(AParent: PWindowsObject; AName: PChar; Orient: Word;ADelay:Word); {As for TToolBar except the ADelay parameter which the help delay for all the buttons} constructor Load(var S: TStream); {Loads DelayTime and NoHelp, and initialises variables} destructor done;virtual; {Releases mouse capture} procedure Store(var S: TStream); virtual; {Store DelayTime and NoHelp} procedure EndMouseOver;virtual; {Calls CloseTipWindow} procedure CloseTipWindow;virtual; {Releases mouse capture and closes window} procedure ShowHelp;virtual; {Makes window returned by GetHelpTipWindow and shows it. Override to, for example, display text on the status line giving more detailed help} function CreateTool(Num: Integer; Origin: TPoint;Command: Word; BitmapName: PChar): PTool;virtual; {Overriden TToolBar method to create THelpToolButtons} procedure WMMouseMove(var Msg: TMessage);virtual wm_First + wm_MouseMove; {Detects when mouse is moved over button and starts timing. Sets GlobalMousePoint to the screen-coordinate of the mouse. Override this method to change the criterion for popping up a tip. By Default tips are shown if the application is active, regardless of which window has the focus.} procedure WMLButtonDown(var Msg: TMessage); virtual wm_First + wm_LButtonDown; {Stops problems with mouse capture and TToolBar} procedure WMLButtonUp(var Msg: TMessage); virtual wm_First + wm_LButtonUp; {Calls CloseTipWindow to close tip once button has been used} procedure TimeOut(var Msg:TMessage);virtual wm_first+wm_timer; {Calls ShowHelp} procedure ReadResource;virtual; {Reads a HELPTOOLBARDATA resource. Sets up the buttons HelpText field from the resource. See above for details of the HELPTOOLBARDATA resource type} procedure DisableHelp;virtual; {Enables pop-up help tips} procedure EnableHelp;virtual; {Disables them} function GetClassName:PChar;virtual; {Returns 'ToolTipBar'} end; {New help tip windows can be descended from the TTipWindow type, which is basically the same as TWindow except how the Attr field is set up.} Type PTipWindow=^TTipWindow; TTipWindow=object(TWindow) constructor init(AParent:PToolbar;MousePos:TPoint;Orient,Width,Height:Word); {Sets up the Attr field appropriately depending on the orientation of the toolbar and the mouse position. Checks if the window rect is on screen, and if not sets the Attr field so that it is. Override to set the window to pop-up in a different position. Sets Attr.Style:=ws_border or ws_popup or ws_disabled} end; {The following objects implement coloured background tips} Type PColorToolButton=^TColorToolButton; TColorToolButton=Object(THelpToolButton) TipFont:PLogFont; constructor Init(AParent: PWindowsObject; X, Y: Integer;ACommand: Word;BitmapName: PChar;ADelay:Word); {Sets TipFont to point to DefTipFont. Calls THelpToolButton.init} function GetHelpTipWindow:PWindow;virtual; {Calculates tip window size on first call. Returns a PColorTipWindow} procedure Read(var S: TStream); virtual; {Sets TipFont to point to DefTipFont and calls inherited method} procedure SetTipFont(APLogFont:PLogFont); {Sets TipFont to APLogFont} end; Type PColorToolTipBar=^TColorToolTipBar; TColorToolTipBar=object(THelpToolBar) function CreateTool(Num: Integer; Origin: TPoint;Command: Word; BitmapName: PChar): PTool;virtual; {Creates ColorToolButtons and spacers} end; Type PColorTipWindow=^TColorTipWindow; TColorTipWindow=object(TTipWindow) BkColor:TColorRef; {Background Colour} TheButton:PColorToolButton; {Button displaying the tip} constructor init(AParent:PToolbar;MousePos:TPoint;Orient,Width,Height:Word; AButton:PColorToolButton); {Sets BkColor to RGB(255,255,0) (yellow) and TheButton to AButton. Calls inherited init} procedure Paint(ADC:HDC;var PaintInfo:TPaintStruct);virtual; {Draws TheButton's HelpText with BkColor background color using TheButton's TipFont} end; const RHelpToolbar: TStreamRec = ( ObjType: 12302; VmtLink: Ofs(TypeOf(THelpToolbar)^); Load: @THelpToolbar.Load; Store: @THelpToolbar.Store); const RColorToolTipBar:TStreamRec = ( ObjType: 12303; VmtLink: Ofs(TypeOf(TColorToolTipbar)^); Load: @TColorToolTipbar.Load; Store: @TColorToolTipbar.Store); const DefTipFont:TLogFont=(lfHeight:16;lfWidth:0;lfEscapement:0;lfOrientation:0;lfWeight:fw_normal; lfItalic:0;lfUnderline:0;lfStrikeout:0;lfCharSet:ANSI_CharSet;lfOutPrecision:Out_Default_Precis; lfClipPrecision:clip_default_precis;lfQuality:Default_Quality; lfPitchAndFamily:Variable_Pitch or ff_DontCare;lfFaceName:'Arial'); {Used by default by TColorTipWindow to draw tip text} implementation uses Win31, Strings; {You can obtain the full source code by paying an additional registration fee of 15 US Dollars or 10 Pounds Sterling. See Above} end.